home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / alrmtpw.exe / ALARM.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-09  |  16KB  |  494 lines
  1. { File:         Alarm.pas }
  2. { Created:      Mon Sep 09 00:25:28 1991 }
  3. { Description:  Main routines for "Alarm" Windows application }
  4.  
  5. {{ STARTBLOCK   File Version Information   (REGENERATE) }
  6. { Regenerated:  Mon Sep 09 00:25:28 1991 }
  7. { Skeleton by:  Winpro/3, a product from Louis J. Cutrona, Jr. }
  8. {               tpw.skl version 0.05 }
  9. {{ ENDBLOCK }
  10.  
  11. program AlarmProgram ;
  12.  
  13. {$R Alarm.res }
  14.  
  15. uses
  16.   WinDos,
  17.   WinTypes,
  18.   WinProcs,
  19.   Strings,
  20.   WObjects,
  21.   StdWnds,
  22.   AlarRC, AlarGbl, AlarDlg ;
  23.  
  24.  
  25. {  A L A R M   }
  26. {  A P P L I C A T I O N  O B J E C T  D E F I N I T I O N  }
  27.  
  28. type
  29.   tAlarm = object( TApplication )
  30.     constructor Init( lpszName: PChar ) ;
  31.     procedure   InitInstance ; virtual ;
  32.     procedure   InitMainWindow ; virtual ;
  33.     procedure   Run ; virtual ;
  34.   end ;
  35.  
  36.  
  37. {  A L A R M   W I N D O W  }
  38. {  M A I N  W I N D O W  O B J E C T  D E F I N I T I O N  }
  39.  
  40. type
  41.   tpAlarmWindow = ^tAlarmWindow ;
  42.   tAlarmWindow = object( TWindow )
  43.     constructor Init( pwoParent: PWindowsObject; lpszTitle: PChar ) ;
  44.     destructor  Done ;  Virtual ;
  45.  
  46.     { We need a new GetWindowClass to have our own icon and menu }
  47.     procedure   GetWindowClass( var WndClass: TWndClass ) ; virtual ;
  48.     { We need to override GetClassName because different Windows }
  49.     { applications must use different class names.               }
  50.     function    GetClassName: PChar ; virtual ;
  51.  
  52.     { One-time initialization after window is created }
  53.     procedure   SetupWindow; virtual ;
  54.  
  55.     { We need to handle wm_Timer messages and wm_User messages }
  56.     procedure   WMTimerMethod( var Msg: TMessage ) ;
  57.                 virtual wm_First + wm_Timer ;
  58.     procedure   WMUserMethod( var Msg: TMessage ) ;
  59.                 virtual wm_First + wm_User ;
  60.  
  61.     { WM_COMMAND processing methods (menu selections & accelerator keys ) }
  62.     procedure   dlg_SetAlarmTimeMethod( var Msg: TMessage ) ;
  63.                 virtual cm_First + dlg_SetAlarmTime ;
  64.     procedure   idmALARMONMethod( var Msg: TMessage ) ;
  65.                 virtual cm_First + idmALARMON ;
  66.     procedure   idmALARMOFFMethod( var Msg: TMessage ) ;
  67.                 virtual cm_First + idmALARMOFF ;
  68.     procedure   dlg_AboutAlarmMethod( var Msg: TMessage ) ;
  69.                 virtual cm_First + dlg_AboutAlarm ;
  70.     procedure   STDCLOSEMethod( var Msg: TMessage ) ;
  71.                 virtual cm_First + STDCLOSE ;
  72.     procedure   idmHIDEMethod( var Msg: TMessage ) ;
  73.                 virtual cm_First + idmHIDE ;
  74.   end ;
  75.  
  76.  
  77.  
  78. { A L A R M   W I N D O W . I N I T }
  79. {{ STARTBLOCK Main window constructor (REGENERATE) }
  80.  
  81. constructor tAlarmWindow.Init( pwoParent: PWindowsObject; lpszTitle: PChar ) ;
  82. begin
  83.   TWindow.Init( pwoParent, lpszTitle ) ;
  84.   Attr.Style := ws_Overlapped
  85.     or ws_Caption
  86.     or ws_SysMenu
  87.     or ws_MinimizeBox
  88.     or ws_ClipSiblings
  89.     (*or ws_Visible*) ;
  90.   Attr.X := 140 ;
  91.   Attr.Y := 150 ;
  92.   Attr.W := 385 ;
  93.   Attr.H := 160 ;
  94. end ;
  95.  
  96. {{ ENDBLOCK }
  97.  
  98. { A L A R M   W I N D O W . D O N E }
  99. { Main window destructor }
  100.  
  101. destructor tAlarmWindow.Done ;
  102. begin
  103.   { Do here any cleanup required when the main window closes }
  104.   if gbl_cAlarmSet = 'Y' then
  105.     KillTimer( hWindow, 1 ) ;
  106.   { Then, call standard cleanup }
  107.   TWindow.Done ;
  108. end ;
  109.  
  110.  
  111. { A L A R M   W I N D O W .  G E T  W I N D O W  C L A S S }
  112. { Modify default window object characteristics }
  113.  
  114. procedure tAlarmWindow.GetWindowClass( var WndClass: TWndClass ) ;
  115. begin
  116.   { Let TWindow set the defaults }
  117.   TWindow.GetWindowClass( WndClass ) ;
  118.  
  119.   {{ STARTBLOCK Override TWindow window class defaults (REGENERATE) }
  120.   WndClass.hIcon         := LoadIcon( hInstance, PChar( ALARM_ICON ) ) ;
  121.   WndClass.lpszMenuName  := PChar( ALARM_MENU ) ;
  122.   WndClass.hbrBackground := color_Window + 1 ;
  123.   {{ ENDBLOCK }
  124. end ;
  125.  
  126. { A L A R M   W I N D O W .  G E T  C L A S S  N A M E }
  127.  
  128. function tAlarmWindow.GetClassName: PChar;
  129. begin
  130.   GetClassName := 'Alarm' ;
  131. end;
  132.  
  133. { Correct execution of the SetupWindow procedure defined below requires }
  134. { short-circuit boolean evaluation.  Although this is the default, it   }
  135. { may have been overridden through settings in the Options|Compiler     }
  136. { menu.  The next line turns short-circuit evaluation on as insurance.  }
  137. {$B-}
  138.  
  139. procedure tAlarmWindow.SetupWindow;
  140. var
  141.   bCancel: Bool ;
  142.   hmenuPopup: HMenu ;
  143.   p: PChar ;
  144. begin
  145.   if gbl_cAlarmSet = 'Y' then
  146.   begin
  147.     { We want a timer.  See if one is available.  If not, give user }
  148.     { the option of cancelling or retrying after shutting down      }
  149.     { something else that uses a timer.                             }
  150.     bCancel := False ;
  151.     while not bCancel and not Bool( SetTimer( hWindow, 1, 30000, nil ) ) do
  152.       if idCancel = MessageBox( hWindow,
  153.         'Sorry, no more clocks or timers available.',
  154.         'Alarm Can''t Run',
  155.         mb_RetryCancel or mb_IconExclamation ) then
  156.         bCancel := True ;
  157.     if bCancel then
  158.       CloseWindow ;
  159.  
  160.     { We got a timer, so check the 'On' menu item and uncheck 'Off' }
  161.     hmenuPopup := GetSubMenu( GetMenu( hWindow ), 0 ) ;
  162.     CheckMenuItem( hmenuPopup, idmALARMON, mf_ByCommand or mf_Checked ) ;
  163.     CheckMenuItem( hmenuPopup, idmALARMOFF, mf_ByCommand or mf_Unchecked ) ;
  164.   end;
  165.   { See if the user specified /s -s /S or -S on the command line and }
  166.   { if so, leave the window visible.                                 }
  167.   if  ( StrPos( CmdLine, '/s' ) = nil )
  168.   and ( StrPos( CmdLine, '-s' ) = nil )
  169.   and ( StrPos( CmdLine, '/S' ) = nil )
  170.   and ( StrPos( CmdLine, '-S' ) = nil ) then
  171.     CmdShow := sw_Hide ;
  172. end;
  173.  
  174.  
  175. procedure tAlarmWindow.WMTimerMethod( var Msg: TMessage ) ;
  176. var
  177.   wDayOfWeek: Word ;
  178.   wSecond: Word ;
  179.   wSec100: Word ;
  180. begin
  181.   GetDate( gbl_wYearNow, gbl_wMonthNow, gbl_wDayNow, wDayOfWeek ) ;
  182.   gbl_wMonthNow := gbl_wMonthNow - 1900 ;
  183.   GetTime( gbl_wHourNow, gbl_wMinuteNow, wSecond, wSec100 ) ;
  184.   if   ( gbl_wYearNow   < gbl_wYearAlarm   )
  185.     or ( gbl_wMonthNow  < gbl_wMonthAlarm  )
  186.     or ( gbl_wDayNow    < gbl_wDayAlarm    )
  187.     or ( gbl_wHourNow   < gbl_wHourAlarm   )
  188.     or ( gbl_wMinuteNow < gbl_wMinuteAlarm ) then
  189.   begin
  190.     { Too early.  Wait a minute }
  191.     SetTimer( hWindow, 1, 30000, nil ) ;
  192.   end
  193.   else
  194.   begin
  195.     { Now! }
  196.     KillTimer( hWindow, 1 ) ;
  197.     gbl_cAlarmSet := 'N' ;
  198.     SendMessage( hWindow, wm_Command, idmALARMOFF, 0 ) ;
  199.     MessageBeep( 0 ) ;
  200.     MessageBox( hWindow,
  201.       dlg_SetAlarmTimeTransferBuf.szEM_MESSAGE,
  202.       'Ding-a-Ling',
  203.       mb_OK or mb_IconAsterisk ) ;
  204.   end ;
  205. end ;
  206.  
  207. procedure tAlarmWindow.WMUserMethod( var Msg: TMessage ) ;
  208. begin
  209.   { If window is hidden, make it visible.  Otherwise, ignore }
  210.   MessageBeep( 0 ) ;
  211.   if not IsWindowVisible( hWindow ) then
  212.   begin
  213.     Show( sw_ShowNormal ) ;
  214.     BringWindowToTop( hWindow ) ;
  215.   end ;
  216. end ;
  217.  
  218.  
  219.  
  220. { AlarmWindow -- WM_COMMAND processing methods }
  221. { (menu selections & accelerator keys ) }
  222.  
  223. {{ STARTBLOCK Main window menu/accelerator selection dlg_SetAlarmTime (REGENERATE) }
  224. procedure tAlarmWindow.dlg_SetAlarmTimeMethod( var Msg: TMessage ) ;
  225. var
  226.   RetCode: Integer ;
  227.   pdlg_SetAlarmTimeDialog: tpdlg_SetAlarmTimeDialog ;
  228.   szBuf: Array[0..11] of Char ;
  229.   i: Integer ;
  230. begin
  231.   pdlg_SetAlarmTimeDialog := New( tpdlg_SetAlarmTimeDialog, Init( @Self, PChar( dlg_SetAlarmTime ) ) ) ;
  232.   RetCode := Application^.ExecDialog( pdlg_SetAlarmTimeDialog ) ;
  233.   if RetCode = id_OK then
  234.   begin
  235.     { User selected OK pushbutton or equivalent. }
  236.     { Updated dialog data are in dlg_SetAlarmTimeTransferBuf. }
  237.     { Translate into numbers }
  238.     with dlg_SetAlarmTimeTransferBuf do
  239.     begin
  240.       { In a more fully developed example, each of these values }
  241.       { would be error-checked.                                 }
  242.       Val( PChar( @szET_YEAR[0] ), gbl_wYearAlarm, RetCode ) ;
  243.       Str( gbl_wYearAlarm:2, szET_YEAR  ) ;
  244.       Val( PChar( @szET_MONTH[0] ), gbl_wMonthAlarm, RetCode ) ;
  245.       Str( gbl_wMonthAlarm:2, szET_MONTH  ) ;
  246.       Val( PChar( @szET_DAY[0] ), gbl_wDayAlarm, RetCode ) ;
  247.       Str( gbl_wDayAlarm:2, szET_DAY  ) ;
  248.       Val( PChar( @szET_HOUR[0] ), gbl_w